{
  Система регистрации сообщений и событий

 Типы сообщений: отладка, информация, подсказка, предупреждение, ошибка
 Все сообщения разбиты по группам
 Наверное сообщения будут разделены по системам
 Основные функции
  - Фиксировать сообщение
  - Получить сообщения по фильтру

   версия 0.2 март 2011 prodg@ya.ru D.Kondakov
}
unit LogSystm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, IIntgrlTypes, IIntgrlObjcts, IIntgrlBaseParms, IIntgrlBaseCnfg;

{$i calcconfig.inc}

type
  TMsgID = TinlID;
  TMsgGrp = (msgDebug, msgInfo, msgHint, msgWrng, msgError);

  { TGeneralMessage }

  TGeneralMessage = class
    selfID: TMsgID;
    groupID: TMsgGrp;
    timeStamp: TinlTimeStamp;
    msgData: pointer;
    constructor Create(grpID: TMsgGrp);
    destructor Destroy; override;
    procedure doCheck;
    procedure doAccept;
  private
    FChecked: TinlLogicType;
    FAcceptd: TinlLogicType;
  public

  end;

  { TSystmLog }

  TSystmLog = class(TinlModule)
    constructor Create(wCfg: TinlConfiguration);
    procedure GetDefParams(DefParams: TStrings); override;
    function CheckParams: TinlLogicType; override;
    procedure AddDefParams(Params: TStringList); override;
    procedure ResetParams; override;
    procedure ProceedSignal(snlMsg: TinlStringType); override;

    function logMsg(g: TMsgGrp; s: TinlStringType): TMsgID;
    procedure GetMessagesAfterID(var LastMsgID: TMsgID; MsgList: TStrings);
    procedure GetMessagesAfterMoment(var LastMsgTime: TinlTimeStamp; MsgList: TStrings);
  private
    FLog: TStringList;
    FLogActive: TinlLogicType;
    fnoDate: TinlLogicType;
    fnoMlSec: TinlLogicType;
  protected
    function GetUnitVersion: TinlModifctn; override;
    procedure DataInit; override;
    procedure DataDone; override;
    function GetModuleType: TModuleType; override;
  public
    property noDate: TinlLogicType read fnoDate write fnoDate default true;
    property noMlSec: TinlLogicType read fnoMlSec write fnoMlSec default false;
//    property TotalErrors:
  end;

const
  LOGmodVer = 1000001;

  msgNot = -1;

implementation

const
  prmNoDate: TcfgParmtrInfo = (
    prmName: 'NO_DATE';
    prmValue: pLogic;
    prmCaption: 'Не писать дату в журнал';
    prmComment: 'Не писать дату события в журнале.';
    DefValue: sNo;
    ChkValue: false;
    prmMngbl: true;
  );

constructor TSystmLog.Create(wCfg: TinlConfiguration);
begin
  FLogActive := false;
  FLog := nil;
  inherited Create(wCfg);
end;

procedure TSystmLog.GetDefParams(DefParams: TStrings);
begin
  DefParams.Add('LOG_TO_FILE=Писать журнал в файл');
  DefParams.Append('LOG_FILE_NAME=Имя файла журнала');
  DefParams.Append('LOG_NO_DATE=Не писать дату в журнал');
  DefParams.Append('LOG_NO_MLSEC=Не писать миллисекунды в журнал');
end;

function TSystmLog.CheckParams: TinlLogicType;
begin
  result := true;
end;

procedure TSystmLog.AddDefParams(Params: TStringList);
begin
  Params.Append('LOG_NO_DATE=1');
  Params.Append('LOG_NO_MLSEC=1');
end;

procedure TSystmLog.ResetParams;
begin
  fnoDate := GetLogicCfgParam('LOG_NO_DATE', true);
  fnoMlSec := GetLogicCfgParam('LOG_NO_MLSEC', true);
end;

procedure TSystmLog.ProceedSignal(snlMsg: TinlStringType);
begin
  logMsg(msgDebug, 'Signal received:'+snlMsg);
end;

function TSystmLog.GetUnitVersion: TinlModifctn;
begin
  Result := LOGmodVer;
end;

procedure TSystmLog.DataInit;
begin
  FLog := TStringList.Create;
  FLogActive := assigned(FLog);
end;

procedure TSystmLog.DataDone;
var
  i: integer;
begin
  for i := FLog.Count-1 downto 0 do FLog.Objects[i].Free;
  FreeAndNil(FLog);
  FLogActive := false;
end;

function TSystmLog.GetModuleType: TModuleType;
begin
  Result := mLOG;
end;

function TSystmLog.logMsg(g: TMsgGrp; s: TinlStringType): TMsgID;
var
  im: TGeneralMessage;
begin
  result := msgNot;
  if not FLogActive then exit;
  im := TGeneralMessage.Create(g);
  FLog.AddObject(s, im);
  im.msgData := @FLog;
  result := FLog.Count;
  im.selfID := result;
end;

procedure TSystmLog.GetMessagesAfterID(var LastMsgID: TMsgID; MsgList: TStrings);
var
  i,j: integer;
begin
  j := FLog.Count-1;
  if LastMsgID<j then begin
    for i := LastMsgID+1 to j do
      MsgList.Add(
        DateTimeToStr(TimeStampToDateTime(TGeneralMessage(FLog.Objects[i]).timeStamp))
        + b + FLog[i]);
    LastMsgID := j;
  end;
end;

procedure TSystmLog.GetMessagesAfterMoment(var LastMsgTime: TinlTimeStamp; MsgList: TStrings);
var
  dt: TDateTime;
  i,j: integer;
begin
  dt := TimeStampToDateTime(LastMsgTime);
  j := FLog.Count-1;
  while (i>0)and(TimeStampToDateTime(TGeneralMessage(FLog.Objects[j]).timeStamp)>dt) do dec(j);
  for i := j to FLog.Count-1 do ;
    MsgList.Add(
      DateTimeToStr(TimeStampToDateTime(TGeneralMessage(FLog.Objects[i]).timeStamp))
      + b + FLog[i]);
  LastMsgTime := TGeneralMessage(FLog.Objects[FLog.Count-1]).timeStamp;
end;

{ TGeneralMessage }

constructor TGeneralMessage.Create(grpID: TMsgGrp);
begin
  inherited Create;
  selfID := msgNot;
  groupID := grpID;
  timeStamp := NowItIs;
  msgData := nil;
  FChecked := false;
  FAcceptd := false;
end;

destructor TGeneralMessage.Destroy;
begin

  inherited;
end;

procedure TGeneralMessage.doCheck;
begin
  FChecked := true;
end;

procedure TGeneralMessage.doAccept;
begin
  FAcceptd := true;
end;

end.

